﻿{
                       Mifare 1卡 通用读卡器 命令

1.	通讯命令帧格式
  STX + 命令码（1byte）+ Data +ETX +CheckSum (1byte)
  STX =  02   EXT = 03  CheckSum：命令码与数据的异或和
  16进制的命令码和数据转成两字节ASCII 码
  串口波特率 9600
2.	命令码

  命令	读块	写块	加载密码	读序列号	 鸣叫
  HEX	 46	47	  4C	   68	  70

3.	读序列号命令帧
  02 36 38 03 0e

4.	鸣叫命令帧
  02 37 30 03 07

5.	读块数据命令帧 
  0x02 + 0x46 + 扇区号 + 块号 + 0x03 +CheckSum

6.	写块数据命令
  0x02 + 0x47 + 扇区号 + 块号 + 待写数据（16字节）+0x03 +CheckSum



                    Mifare 1 卡块定义
1.	扇区0
1)	块0是卡信息只读区  

2.	扇区1 
1)	块4-5	备用区
2)	块6	数据格式：(考勤)
  前八字节卡号       后八字节姓名
  前八字节： 卡号从低位开始， 第三个字节  高四位为$6
  后八字节：  按asic2 码 + $60，  剩余为 $80
  40 E2 61 00 00 00 00 00    91 91 91 91 80 80 80 80
  卡号1E240
       
3.	扇区2  姓名 部门 身份 
1)	块8	姓名
2)	块9	部门
3)	块10	身份

4.	扇区3-8  备用区

5.	扇区9 卡号和账户
1)	块36 定义:             字节(每块16字节)
  卡号        			  0、1、2
  有效期      			   3、4
  单笔限额    			  5、6  	(备用)
  日限额      			   7、8  	(备用)
  透支信用    			  9、10 	(备用)
  卡类型标志  			   11
  用户码		  			   12、13
  未定义	     			   14      (备用)
  异或校验和  			   15

2)	块37 定义					
  个人账户剩余金额    0、1、2
  日消费累计       	 3、4、5
  当日日期        		6
  单笔限额    			  7、	8
  日限额      			   9、	10
  透支信用    			  11、12（要写）
  备用             		13
  挂失             		14    （0 正常，1 挂失）
  异或较验和       	 15    （金额3字节异或和）



3)	块38 定义
  消费当餐时间段     0、1、2、3
  当餐消费次数       4 (联机)、5 (脱机)
  本月剩余次数       6
  消费当日日期       7
  身份(ID)           8
  计次表版本号       9 10
  挂失               11
  备用               12、13、14(未定义)
  异或校验和         15(0、1、2字节)

  扇区10~ 15        备用区


}

unit uMifare;

interface

uses windows, SysUtils, Classes, Controls,MSCommLib_TLB, uCard, CommonTypes;

Type
  BtArray = array of byte;

  EMifareError = class(Exception);

  Tmifare = class
  private
    FPort: Integer;
    FBaudSettings: string;
    Fcomm: TMSComm;
    procedure SetActive(const Value: Boolean);
    function GetActive: Boolean;
    procedure InitializeCom();
    //写卡块数据
    procedure WriteBlockData(BlockID: Byte; Data: BtArray);
    //读块数据
    function ReadBlockData(BlockNo :Smallint; var Data: BtArray): Boolean;
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(Port: Integer; BaudSettings: string = '9600,n,8,1');
    destructor Destroy; override;

    function LoadKeyA(Sector :Smallint;Key :String):string;
    function ReadName():String;
    function ReadDegree(var DegreeID :Byte):string;
    function ReadDepartment():String;
    function ReadCardBlock(BlockNo :Smallint):String;
    function ReadCardBlockA(BlockNo :Smallint):String;
    function ReadAddressFlag(var Flag :Smallint):longint;
    function ReadBalance(var Balance :CURRENCY):string;
    function GetCardSerialNo() :Longint;
    function GetCardInfo(var CardFlag :Smallint;var ValidDate :TDateTime;var SingleLimit :Smallint;var DayLimit :Smallint;var Overdraft :Smallint):Longint;
    function ReadPassword():String;
    function ReadValidDate():longint;
    function ClearCardBuffer():String;
    function WriteCardBlock(BlockNo:Smallint;Data:BtArray;DataLen:integer):String;
    function WriteAddress(Address:Longint):string ;
    function WriteAddressFlag(Address:Longint; Flag:Smallint):string;


    function WritePassword(Password:String):String;
    function WriteValidDate(ValidDate:longint):String;

    procedure Beep();
    //读卡地址
    function ReadCardNumber: Int64;


    //读卡标志
    function ReadCardFlag: byte;
    //读卡中信息：
    procedure ReadCard(aCard: TCard);


    //写卡信息
    procedure WriteCardInfo(aCard: TCard);
    //写卡部门
    procedure WriteDepartment(Department: String);
    //写名称
    procedure WriteName(Name: String);
    //写身份
    procedure WriteDegree(Degree :string; DegreeID: Byte);
    //写卡号
    procedure WriteCardNumber(aNumber: Int64);
    //写金额区
    procedure WriteMoney(aCard: TCard);
    //写剩余金额
    procedure OnlyWriteLastMoney(aCard: TCard);
    ///////////////
    //针对依时利
    //在一扇区（5块）中写入卡号和姓名。
    //前八字节写卡号 后八字节写姓名
    procedure WriteEast(aCard: TCard);



    //清空卡信息,现在只把卡号写为0
    procedure Clear;


    property Active: Boolean read GetActive write SetActive;
  end;




// MIFARE读写器命令字
 const	STX=$02;
 const	ETX=$03;

 const	mfReadData  =$46;
 const	mfWriteData =$47;
 const	mfLoadKeyA  =$4C;
 const	mfReadSnr   =$68;
 const  mfStroke    =$70;

/////////////////////////////////////////////////////////
//                   块定义
//
 const  mcbCardInfo        = 36; // 卡信息
 const	mcbAddress         = 36; // 卡地址
 const	mcbCardFlag        = 36; // 卡标志
 const	mcbBalance         = 37; // 余额
 const	mcbLimit           = 37; // 单次限额 日限额
 const	mcbValidDate       = 38; // 有效期
 const	mcbName            =  8; // 姓名
 const	mcbDepartment      = 9;  // 部门
 const	mcbDegree          = 10; // 身份(字符串)
 const	mcbDegreeID        = 10; // 身份标识号
 const	mcbPassword        = 14; // 密码
 const  mcbWaterInfo       = 12; // 脱机水控块
 const  mcbBackupWaterInfo = 13; // 脱机水控备用数据块


 const  mcbEast            =  6; // 考勤块

 const	mcbBufferPointer   = 12; // 消费缓冲区指针
 const	mcbBufferHead      = 16; // 消费缓冲区第1块
 const	mcbBufferTail      = 34; // 消费缓冲区最后块

 const  mbbCardFlagByte    = 12; // 卡标志存放于第12字节
 const	mbbDegreeIDByte    = 15; // 身份标识号存放于第15字节

 const	mbbSingleLimit     = 6;  //单次限额在6字节开始
 const	mbbDayLimit        = 8;  //日限额在8字节开始
 const	mbbOverdraf        = 10; //透支信用在10字节开始


implementation



function hi(X:Word) :Byte;
begin
  Result :=X shr 8;
end;

function lo(X:Word) :Byte;
begin
  Result :=X
end;

function HiAscii(bData :BYTE ): BYTE;
begin
  Result:=bData div 16;
  if Result < 10 then
    Result := Result +48
  else
    Result := Result +55;
end;

function LoAscii(bData :BYTE ) :BYTE;
begin
  Result:=bData mod 16;
  if Result<10 then
    Result := Result +48
  else
    Result := Result +55;

end;

function GenCheckSum(pbData :BtArray ;len :WORD) :BYTE;
var
  bData : BYTE;
  i :Word;
begin
	// 校验和是命令字与数据的异或和
  bData :=pbData[1];
  for i:=2 to len-1  do
    bData := bData xor pbData[i];

	Result := bData;
end;

function VerifyCheckSum(pbData :BtArray ;len :WORD ):Boolean;
var
  bdata :BYTE;
  i :Word;
begin
	// 帧格式: STX+命令字+数据+ETX+CHECKSUM
	bData:=pbData[1];
  for i:=2 to len-2-1 do
    bData := bData xor pbData[i];
  Result :=(bData=pbData[len-1]);
end;

procedure RemoveFrameHead(pData:BtArray;len :integer );
var
  i:integer;
begin
  for i:=0 to len-3-1 do
    pData[i]:=pData[i+1];
	pData[len-3]:=0;
end;

// 16进制字符串转为字节
function Hex2Byte(h1:BYTE ;h2:BYTE):BYTE;
begin
  if h1 >ord('9') then h1 := h1 - ord('A')  +10
                else h1 := h1 - ord('0');
  if h2 >ord('9') then h2 := h2 - ord('A')  +10
                else h2 := h2 - ord('0');
  Result :=h1 *16 + h2;
end;

function HexByte(h1:BYTE):BYTE;
begin
  if h1 >ord('9') then h1 := h1 - ord('A')  +10
                else h1 := h1 - ord('0');
  Result :=h1;
end;

// ASCII解码
procedure AsciiDecode(pbData :BtArray ;len :integer);
var
  i :integer;
begin
  for i:=0 to (len div 2) do
    pbData[i] := Hex2Byte(pbData[2*i],pbData[2*i+1]);
	pbData[len div 2]:=0;
end;

//
function BtHexToLong(pbData :BtArray ;Si,Ei :integer):Longint;
var
  i:integer;
begin
  Result :=0;
  for i:=si to Ei do
  begin
    Result :=Result *16 +HexByte(pbData[i]);
  end;
end;

{ Tmifare }



procedure Tmifare.Beep;
var
  pData :BtArray;
begin
	// TODO: Add your dispatch handler code here
  if (Fcomm=nil) or (not Fcomm.PortOpen) then exit;
  setlength(pData,5);
	pData[0]:=STX;
	pData[1]:=HiAscii(mfStroke);
	pData[2]:=LoAscii(mfStroke);
	pData[3]:=ETX;
	pData[4]:=GenCheckSum(pData,3);
	Fcomm.Input;
  Fcomm.Output :=pData;

end;

procedure Tmifare.Clear;
begin
  WriteCardNumber(0);
end;

function Tmifare.ClearCardBuffer: String;
begin
  Result :=WriteCardBlock(mcbBufferPointer,nil,0);
end;



constructor Tmifare.Create(Port: Integer; BaudSettings: string);
begin
  FPort := Port;

  FBaudSettings := BaudSettings;
  if FBaudSettings = '' then FBaudSettings := '9600,n,8,1';

end;


destructor Tmifare.Destroy;
begin
  Fcomm.Free;
  
  inherited;
end;


function Tmifare.GetActive: Boolean;
begin
  if not Assigned(FComm) then
    InitializeCom;
  Result := Fcomm.PortOpen;
  
end;

function Tmifare.GetCardInfo(var CardFlag: Smallint; var ValidDate: TDateTime;
  var SingleLimit, DayLimit, Overdraft: Smallint): Longint;
var
  lAddress :longint;
  pData,rData :BtArray;
  DataCount ,i:integer;
begin
	// TODO: Add your dispatch handler code here
  lAddress:=-1;
	while True do
  begin
		if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
	  SetLength(pData,9);
		pData[0]:=STX;
		pData[1]:=HiAscii(mfReadData);
		pData[2]:=LoAscii(mfReadData);
		pData[3]:=HiAscii(BYTE(mcbAddress div 4));
		pData[4]:=LoAscii(BYTE(mcbAddress div 4));
		pData[5]:=HiAscii(BYTE(mcbAddress));
		pData[6]:=LoAscii(BYTE(mcbAddress));
		pData[7]:=ETX;
		pData[8]:=GenCheckSum(pData,7);

		Fcomm.Input;
		Fcomm.Output:=pData;
		Sleep(250);

		DataCount:=Fcomm.InBufferCount;
		if(DataCount=0) then break ;
		rData :=Fcomm.Input;

		if (not VerifyCheckSum(rData,DataCount)) then break;
                if DataCount<=5 then break;
                for i:=0 to 6-1 do  pData[i] := rData[i+1];
                pData[6]:=ord('H');
                lAddress:=BtHexToLong(pData,0,5);


		CardFlag:=Hex2Byte(rData[mbbCardFlagByte*2-1],rData[mbbCardFlagByte*2]);

		for i:=0 to 4-1 do  pData[i] := rData[i+1];
		pData[4]:=ord('H');
		ValidDate:=BtHexToLong(pData,0,3);

                SingleLimit :=BtHexToLong(rData,mbbSingleLimit*2-1,(mbbSingleLimit+1)*2);
                DayLimit :=BtHexToLong(rData,mbbDayLimit*2-1,(mbbDayLimit+1)*2);
                Overdraft :=BtHexToLong(rData,mbbOverdraf*2-1,(mbbOverdraf+1)*2);
    
		break;
	end;
  
	Result:=lAddress;

end;

function Tmifare.GetCardSerialNo: Longint;
var
  CardNo :Longword;
  pData,rData :BtArray;
  DataCount  :integer;
begin
  Result :=0;
  if (Fcomm=nil) or (not Fcomm.PortOpen) then exit;
  CardNo :=0;
  SetLength(pData,5);

	pData[0]:=STX;
	pData[1]:=HiAscii(mfReadSnr);
	pData[2]:=LoAscii(mfReadSnr);
	pData[3]:=ETX;
	pData[4]:=GenCheckSum(pData,3);
	Fcomm.Input;

	Fcomm.Output:=pData;
	Sleep(550);
  DataCount:=Fcomm.InBufferCount;     //接收缓冲区的字符数目
	if (DataCount>0) then
	begin
		rData :=Fcomm.Input;
		if (VerifyCheckSum(rData,DataCount)) then
    begin
			rData[0]:=ord('0');
			rData[1]:=ord('$');
			rData[2]:=ord('0');
			rData[DataCount-1]:=0;
			rData[DataCount-2]:=0;
			CardNo:=BtHexToLong(rData,3,DataCount-3);
		end;
	end;

	Result :=CardNo;
end;

procedure Tmifare.InitializeCom();
begin

  try
    if not Assigned(Fcomm) then
    begin
      Fcomm :=TMSComm.Create(nil);

      if Fcomm.PortOpen then Fcomm.PortOpen:=False;
      Fcomm.CommPort := FPort;
      Fcomm.Settings := FBaudSettings;
      // 设置缓冲区
      Fcomm.InBufferSize  :=2048;
      Fcomm.OutBufferSize :=1024;
      Fcomm.InputMode     :=1;          // 设置数据通讯格式为二进制
      Fcomm.PortOpen      :=True;
      Fcomm.Input ;                 // 清除串口输入缓冲区
    end;

  except
    raise Exception.Create('初始化串口' + IntTostr(FPort) + '失败！');
  end;

end;

function Tmifare.LoadKeyA(Sector: Smallint; Key: String): string;
var
  pData,rData :BtArray;
  DataCount,i :integer;
  len :integer;
begin
  SetLength(pData,21);

  Result :='';
	// TODO: Add your dispatch handler code here
	while true do
  begin
		if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
		pData[0]:=STX;
		pData[1]:=HiAscii(mfLoadKeyA);
		pData[2]:=LoAscii(mfLoadKeyA);
		pData[3]:=HiAscii(BYTE(Sector));
		pData[4]:=LoAscii(BYTE(Sector));
		pData[5]:=ord('0');
		pData[6]:=ord('0');
    for i:=0 to 12-1 do pData[i]:=0;
    len :=length(key);
    if len>12 then len:=12;
    for i:=0 to Len-1 do pData[i+7]:=ord(key[i+1]);
		pData[19]:=ETX;
		pData[20]:=GenCheckSum(pData,19);
		Fcomm.Input;
		Fcomm.Output :=pData;
		Sleep(350);
		DataCount:=Fcomm.InBufferCount;   //接收缓冲区的字符数目
		if (DataCount=0) then break ;
    rData:=Fcomm.Input;
		if (not VerifyCheckSum(rData,DataCount)) then break;
		RemoveFrameHead(rData,DataCount);
    for i:=0 to DataCount-3-1 do
      Result:= Result + chr(rData[i]);
		break;
	end;

end;


function Tmifare.ReadAddressFlag(var Flag: Smallint): longint;
var
  lAddress :longint;
  pData,rData :BtArray;
  DataCount,i :integer;
begin
  lAddress:=-1;
	while true do
	begin

		if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
	  SetLength(pData,9);
		pData[0]:=STX;
		pData[1]:=HiAscii(mfReadData);
		pData[2]:=LoAscii(mfReadData);
		pData[3]:=HiAscii(BYTE(mcbAddress div 4));
		pData[4]:=LoAscii(BYTE(mcbAddress div 4));
		pData[5]:=HiAscii(BYTE(mcbAddress));
		pData[6]:=LoAscii(BYTE(mcbAddress));
		pData[7]:=ETX;
		pData[8]:=GenCheckSum(pData,7);
		Fcomm.Input;

		Fcomm.Output :=pData;
		Sleep(300);
		DataCount:=Fcomm.InBufferCount;
		if (DataCount=0) then break ;
		rData:=Fcomm.Input;
		if (not VerifyCheckSum(rData,DataCount)) then break;

                if DataCount<=5 then Break;
                for i:=0 to 6-1 do pData[i] :=rData[i+1];
                  lAddress :=BtHexToLong(pData,0,5);
                Flag:=Hex2Byte(rData[mbbCardFlagByte*2-1],rData[mbbCardFlagByte*2]);
		break;
	end;
  Result :=lAddress;
end;

function Tmifare.ReadBalance(var Balance: CURRENCY): string;
var
  pData,rData :BtArray;
  DataCount:integer;
  plus :integer;
begin
	// TODO: Add your dispatch handler code here
  Result :=''; Balance :=0;
	while True do
  begin
		if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
	  SetLength(pData,9);
		pData[0]:=STX;
		pData[1]:=HiAscii(mfReadData);
		pData[2]:=LoAscii(mfReadData);
		pData[3]:=HiAscii(BYTE(mcbBalance div 4));
		pData[4]:=LoAscii(BYTE(mcbBalance div 4));
		pData[5]:=HiAscii(BYTE(mcbBalance));
		pData[6]:=LoAscii(BYTE(mcbBalance));
		pData[7]:=ETX;
		pData[8]:=GenCheckSum(pData,7);

		Fcomm.Input;
		Fcomm.Output:=pData;
		Sleep(250);

		DataCount:=Fcomm.InBufferCount;
		if(DataCount=0) then break ;
		rData :=Fcomm.Input;

		if (not VerifyCheckSum(rData,DataCount)) then break;

    plus :=1;
    if (rData[1] And $80) <>0   then
    begin
      rData[1] := (rData[1] And $7F);
      plus :=-1;
    end;
    Balance :=BtHexToLong(rData,1,4)+BtHexToLong(rData,5,6)*0.01;
    Balance :=Balance * plus;
		break;
	end;

end;


function Tmifare.ReadBlockData(BlockNo: Smallint; var Data: BtArray): Boolean;
var
  sData, rData: BtArray;
  DataCount: integer;
  i: integer;
begin
  Result := False;
  Active := True;

  if ((BlockNo<4) OR ((BlockNo+1) MOD 4 = 0) OR (BlockNo>63)) then Exit;

  setlength(sData,9);
  sData[0]:=STX;
  sData[1]:=HiAscii(mfReadData);
  sData[2]:=LoAscii(mfReadData);
  sData[3]:=HiAscii(BYTE(BlockNo div 4));
  sData[4]:=LoAscii(BYTE(BlockNo div 4));
  sData[5]:=HiAscii(BYTE(BlockNo));
  sData[6]:=LoAscii(BYTE(BlockNo));
  sData[7]:=ETX;
  sData[8]:=GenCheckSum(sData,7);
  Fcomm.Input;
  Fcomm.Output :=sData ;
  Sleep(400);

  DataCount:=Fcomm.InBufferCount;

  if DataCount=0 then exit;

  rData :=Fcomm.Input;

  //返回数据：头（1字节） + 数据（32字节） + 尾（2字节）
  if ((DataCount <> 35) or (not VerifyCheckSum(rData,DataCount))) then exit;

  SetLength(Data, 16);
  
  for i:=0 to 15 do
  begin
    Data[i] := Hex2Byte(byte(rData[i*2+1]), byte(rData[i*2+2]));
  end;

  Result := True;

end;


//读卡中信息：
procedure Tmifare.ReadCard( aCard: TCard);
var
  rData :BtArray;
  DataCount:integer;
  flag: Byte;
begin

  if not ReadBlockData(mcbCardInfo, rData) then
    raise EMifareError.Create('未读到卡数据');

  aCard.Number := rData[0] * $100 * $100 + rData[1] * $100 + rData[2];
  flag := rData[11];

  if (flag = Byte(Card_NoneDefine)) or (flag = Byte(Card_Cashier)) then
  begin
    aCard.Flag := TCardFlag(flag);
  end;


end;

function Tmifare.ReadCardBlock(BlockNo: Smallint):String;
var
  pData,rData :BtArray;
  DataCount :integer;
  i:integer;
begin
  //
  Result :='';
  while True do
  begin
    if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
    if ( (BlockNo<4) OR ((BlockNo+1) MOD 4 = 0) OR (BlockNo>63) ) then Break;
    setlength(pData,9);
		pData[0]:=STX;
		pData[1]:=HiAscii(mfReadData);
		pData[2]:=LoAscii(mfReadData);
		pData[3]:=HiAscii(BYTE(BlockNo div 4));
		pData[4]:=LoAscii(BYTE(BlockNo div 4));
		pData[5]:=HiAscii(BYTE(BlockNo));
		pData[6]:=LoAscii(BYTE(BlockNo));
		pData[7]:=ETX;
		pData[8]:=GenCheckSum(pData,7);
    Fcomm.Input;
    Fcomm.Output :=pData ;
    Sleep(400);

    DataCount:=Fcomm.InBufferCount;
    if DataCount=0 then Break;
    rData :=Fcomm.Input;
    if ((DataCount<16) or (not VerifyCheckSum(rData,DataCount)) ) then break;
    RemoveFrameHead(rData,DataCount);
    AsciiDecode(rData,DataCount-3);
    for i:=0 to ((DataCount-3) div 2) -1 do
    if rData[i]=0 then
      break
    else
      Result:=Result+ chr(rData[i]);
      
    Break;

  end;

end;

function Tmifare.ReadCardBlockA(BlockNo: Smallint): String;
var
  pData,rData :BtArray;
  DataCount :integer;
  i:integer;
begin
  //
  Result :='';
  while True do
  begin
    if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
    if ( (BlockNo<4) OR ((BlockNo+1) MOD 4 = 0) OR (BlockNo>63) ) then Break;
    setlength(pData,9);
		pData[0]:=STX;
		pData[1]:=HiAscii(mfReadData);
		pData[2]:=LoAscii(mfReadData);
		pData[3]:=HiAscii(BYTE(BlockNo div 4));
		pData[4]:=LoAscii(BYTE(BlockNo div 4));
		pData[5]:=HiAscii(BYTE(BlockNo));
		pData[6]:=LoAscii(BYTE(BlockNo));
		pData[7]:=ETX;
		pData[8]:=GenCheckSum(pData,7);
    Fcomm.Input;
    Fcomm.Output :=pData ;
    Sleep(400);

    DataCount:=Fcomm.InBufferCount;
    if DataCount=0 then Break;
    rData :=Fcomm.Input;
    if  (not VerifyCheckSum(rData,DataCount))  then break;
    RemoveFrameHead(rData,DataCount);
    for i:=0 to (DataCount-3) -1 do
      Result:=Result+ chr(rData[i]);
    Break;

  end;

end;

function Tmifare.ReadCardFlag: byte;
var
  rData :BtArray;
begin

  if not ReadBlockData(mcbCardFlag, rData) then
    raise EMifareError.Create('未读到卡数据');
    
  Result := rData[11];
end;

function Tmifare.ReadCardNumber: Int64;
var
  pData,rData :BtArray;
  DataCount,i :integer;
begin
  Result := -1;
  Active := True;
  SetLength(pData,9);
  pData[0]:=STX;
  pData[1]:=HiAscii(mfReadData);
  pData[2]:=LoAscii(mfReadData);
  pData[3]:=HiAscii(BYTE(mcbAddress div 4));
  pData[4]:=LoAscii(BYTE(mcbAddress div 4));
  pData[5]:=HiAscii(BYTE(mcbAddress));
  pData[6]:=LoAscii(BYTE(mcbAddress));
  pData[7]:=ETX;
  pData[8]:=GenCheckSum(pData,7);
  Fcomm.Input;

  Fcomm.Output :=pData;
  Sleep(300);
  DataCount:=Fcomm.InBufferCount;
  if (DataCount=0) then Exit;
  rData:=Fcomm.Input;
  if (not VerifyCheckSum(rData,DataCount)) then exit;

  if DataCount<=5 then exit;

  for i:=0 to 6-1 do
    pData[i] :=rData[i+1];

  Result :=BtHexToLong(pData,0,5);
end;

function Tmifare.ReadDegree(var DegreeID: Byte): string;
var
  pData,rData :BtArray;
  DataCount ,i:integer;
begin
  Result :='';
	while true do
	begin
		if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
    SetLength(pData,9);
		pData[0]:=STX;
		pData[1]:=HiAscii(mfReadData);
		pData[2]:=LoAscii(mfReadData);
		pData[3]:=HiAscii(BYTE(mcbDegree div 4));
		pData[4]:=LoAscii(BYTE(mcbDegree div 4));
		pData[5]:=HiAscii(BYTE(mcbDegree));
		pData[6]:=LoAscii(BYTE(mcbDegree));
		pData[7]:=ETX;
		pData[8]:=GenCheckSum(pData,7);

		Fcomm.Input;

		Fcomm.Output:=pData;
		Sleep(250);
		DataCount:=Fcomm.InBufferCount;
		if (DataCount=0) then break ;
		rData:=Fcomm.Input;
		if ((DataCount<16) OR ( not VerifyCheckSum(rData,DataCount))) then break;
		RemoveFrameHead(rData,DataCount);
		AsciiDecode(rData,DataCount-3);
		DegreeID:=rData[mbbDegreeIDByte];
		rData[mbbDegreeIDByte]:=0;

    for i:=0 to mbbDegreeIDByte-1 do
    if rData[i]=0 then
      break
    else  
      Result :=Result + char(rData[i]);
		break;
	end;

end;

function Tmifare.ReadDepartment: String;
begin
  Result :=ReadCardBlock(mcbDepartment);
end;


function Tmifare.ReadName: String;
begin
  Result :=ReadCardBlock(mcbName);
end;


function Tmifare.ReadPassword: String;
begin
  Result :=ReadCardBlock(mcbPassword);
end;

function Tmifare.ReadValidDate: longint;
var
  lValidDate :longint;
  pData,rData :BtArray;
  DataCount ,i:integer;
begin
  lValidDate:=0;
	while True do
  begin
		if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
		SetLength(pData,9);
		pData[0]:=STX;
		pData[1]:=HiAscii(mfReadData);
		pData[2]:=LoAscii(mfReadData);
		pData[3]:=HiAscii(BYTE(mcbValidDate div 4));
		pData[4]:=LoAscii(BYTE(mcbValidDate div 4));
		pData[5]:=HiAscii(BYTE(mcbValidDate));
		pData[6]:=LoAscii(BYTE(mcbValidDate));
		pData[7]:=ETX;
		pData[8]:=GenCheckSum(pData,7);

		Fcomm.Input;

		Fcomm.Output:=pData;
		Sleep(250);
		DataCount:=Fcomm.InBufferCount;
		if (DataCount=0) then break ;
		rData :=Fcomm.Input;
		if (not VerifyCheckSum(rData,DataCount)) then break;

		for i:=0 to 6-1 do pData[i]:=rData[i+1];
		pData[6]:=ord('H');
		lValidDate:=BtHexToLong(pData,0,5);
		break;
  end;
  Result :=lValidDate;
end;

procedure Tmifare.SetActive(const Value: Boolean);
begin
  InitializeCom;
  if not (Value = Fcomm.PortOpen) then
  begin
    Fcomm.PortOpen := Value;
  end;
end;


function Tmifare.WriteAddress(Address: Integer): string;
var
  pAddress :BtArray;
begin
  SetLength(pAddress,4);
	pAddress[0]:= lo(Address shr 16);
	pAddress[1]:= hi(Address And $ffff);
	pAddress[2]:= lo(Address And $ffff);
	pAddress[3]:= 0;

	Result:= WriteCardBlock(mcbAddress,pAddress,3);
end;

function Tmifare.WriteAddressFlag(Address: Integer;
  Flag: Smallint): string;
var
  pAddress :BtArray;
  i :integer;
begin
  SetLength(pAddress,16);
	pAddress[0]:= lo(Address shr 16);
	pAddress[1]:= hi(Address And $ffff);
	pAddress[2]:= lo(Address And $ffff);
	for i:=3 to 16-1 do pAddress[i] := 0;
	pAddress[mbbCardFlagByte-1]:= BYTE(Flag);
        //modify 20060405 mbbCardFlagByte -> mbbCardFlagByte-1
	Result:= WriteCardBlock(mcbAddress,pAddress,16);
end;


procedure Tmifare.WriteBlockData(BlockID: Byte; Data: BtArray);
var
  pData,rData :BtArray;
  DataCount , i, DataLen:integer;
  retStr: string;
begin

	SetLength(pData,41);
  DataLen := High(Data) + 1;

  Active := True;
  pData[0]:=STX;
  pData[1]:=HiAscii(mfWriteData);
  pData[2]:=LoAscii(mfWriteData);
  pData[3]:=HiAscii(BYTE(BlockID div 4));
  pData[4]:=LoAscii(BYTE(BlockID div 4));
  pData[5]:=HiAscii(BYTE(BlockID));
  pData[6]:=LoAscii(BYTE(BlockID));
  for i:=0 to 16-1 do
  begin
    if (i<DataLen) then
    begin
      pData[i*2+7]:=HiAscii(Data[i]);
      pData[i*2+8]:=LoAscii(Data[i]);
    end
    else
    begin
      pData[i*2+7]:=48;
      pData[i*2+8]:=48;
    end;
  end;
  pData[39]:=ETX;
  pData[40]:=GenCheckSum(pData,39);
  Fcomm.Input;

  Fcomm.Output :=pData;
  sleep(300);
  DataCount:=Fcomm.InBufferCount;     //接收缓冲区的字符数目
  if (DataCount=0) then raise EMifareError.Create('读卡器无应答');
  rData :=Fcomm.Input;

  if (not VerifyCheckSum(rData,DataCount)) then raise EMifareError.Create('读卡器应答校验错误');

  RemoveFrameHead(rData,DataCount);

  retStr := '';
  for i:=0 to DataCount-3-1 do
  begin
    if rData[i] = 0 then
      break
    else
      retStr :=retStr + chr(rData[i]);
  end;
  if retStr <> '00' then
    raise EMifareError.Create('写数据失败');

end;

function Tmifare.WriteCardBlock(BlockNo: Smallint; Data: BtArray;
  DataLen: integer): String;
var
  pData,rData :BtArray;
  DataCount ,i:integer;
begin
  Result :='';
	SetLength(pData,41);
	while True do
	begin
		if (Fcomm=nil) or (not Fcomm.PortOpen) then Break;
		pData[0]:=STX;
		pData[1]:=HiAscii(mfWriteData);
		pData[2]:=LoAscii(mfWriteData);
		pData[3]:=HiAscii(BYTE(BlockNo div 4));
		pData[4]:=LoAscii(BYTE(BlockNo div 4));
		pData[5]:=HiAscii(BYTE(BlockNo));
		pData[6]:=LoAscii(BYTE(BlockNo));
		for i:=0 to 16-1 do
		begin
			if (i<DataLen) then
			begin
				pData[i*2+7]:=HiAscii(Data[i]);
				pData[i*2+8]:=LoAscii(Data[i]);
			end
			else
      begin
				pData[i*2+7]:=48;
				pData[i*2+8]:=48;
			end;
		end;
		pData[39]:=ETX;
		pData[40]:=GenCheckSum(pData,39);
		Fcomm.Input;

		Fcomm.Output :=pData;
		sleep(300);
	  DataCount:=Fcomm.InBufferCount;     //接收缓冲区的字符数目
		if(DataCount=0) then break ;
		rData :=Fcomm.Input;
		if (not VerifyCheckSum(rData,DataCount)) then break;
		RemoveFrameHead(rData,DataCount);
    for i:=0 to DataCount-3-1 do
      if rData[i]=0 then break
      else Result :=Result + chr(rData[i]);
      break;
  end;

end;

procedure Tmifare.WriteCardInfo(aCard: TCard);
var
  pAddress :BtArray;
  i :integer;
begin
	SetLength(pAddress,16);

	pAddress[0]:= lo(aCard.Number shr 16);
	pAddress[1]:= hi(aCard.Number And $ffff);
	pAddress[2]:= lo(aCard.Number And $ffff);
	pAddress[3]:= $ff;
	pAddress[4]:= $ff;
	pAddress[5]:= 0;
	for i:=5 to 16-1 do pAddress[i] := 0;
    pAddress[mbbCardFlagByte-1] := BYTE(aCard.Flag);

 	pAddress[mbbSingleLimit-1]:= hi(aCard.SingleLimit And $ffff);
	pAddress[mbbSingleLimit]:= lo(aCard.SingleLimit And $ffff);

	pAddress[mbbDayLimit-1]:= hi(aCard.DayLimit And $ffff);
	pAddress[mbbDayLimit]:= lo(aCard.DayLimit And $ffff);

	pAddress[mbbOverdraf-1]:= hi(aCard.Overdraft And $ffff);
	pAddress[mbbOverdraf]:= lo(aCard.Overdraft And $ffff);

	pAddress[12]:= lo(aCard.UserCode shr 16);
	pAddress[13]:= hi(aCard.UserCode And $ffff);
	pAddress[14]:= lo(aCard.UserCode And $ffff);

  WriteBlockData(mcbAddress,pAddress);

end;

procedure Tmifare.WriteCardNumber(aNumber: Int64);
var
  pAddress :BtArray;
begin
  SetLength(pAddress,4);
	pAddress[0]:= lo(aNumber shr 16);
	pAddress[1]:= hi(aNumber And $ffff);
	pAddress[2]:= lo(aNumber And $ffff);
	pAddress[3]:= 0;

	WriteBlockData(mcbAddress,pAddress);
end;

procedure Tmifare.WriteDegree(Degree: string; DegreeID: Byte);
var
  pData :BtArray;
  i :integer;
  len : BYTE;
begin
  SetLength(pData,16);
  len:=length(Degree);
  if len > 15 then
    raise EMifareError.Create('身份长度大于15');

	for i:=0 to 16-1 do
	begin
		if (i<len) then pData[i]:=ord(Degree[i+1])
		else pData[i]:=0;
	end;
	pData[mbbDegreeIDByte] :=BYTE(DegreeID);

	WriteBlockData(mcbDegree,pData);
end;


procedure Tmifare.WriteDepartment(Department: String);
var
  pData :BtArray;
  i,len:integer;
begin
  len :=length(Department);
  if len > 16 then
    raise EMifareError.Create('部门长度超过16位');
  SetLength(pData,len);
  for i:=0 to len-1 do
    pData[i] :=ord(Department[i+1]);

  WriteBlockData(mcbDepartment,pData);
end;

procedure Tmifare.WriteName(Name: String);
var
  pData :BtArray;
  i,len:integer;
begin
  len :=length(Name);
  if len > 16 then
    raise EMifareError.Create('姓名长度超过16');
  SetLength(pData,len);
  for i:=0 to len-1 do pData[i] :=ord(Name[i+1]);

  WriteBlockData(mcbName,pData);
  
end;

function Tmifare.WritePassword(Password: String): String;
var
  pData :BtArray;
  i,len:integer;
begin
  len :=length(Password);
  SetLength(pData,len);
  for i:=0 to len-1 do pData[i] :=ord(Password[i+1]);
  Result :=WriteCardBlock(mcbPassword,pData,len);
end;

function Tmifare.WriteValidDate(ValidDate: Integer): String;
var
  pData :BtArray;
begin
	// TODO: Add your dispatch handler code here
  SetLength(pData,4);
	pData[0]:= lo(ValidDate shr 16);
	pData[1]:= hi(ValidDate And $ffff);
	pData[2]:= lo(ValidDate And $ffff);
	pData[3]:= 0;

	Result := WriteCardBlock(mcbValidDate,pData,3);
end;


procedure Tmifare.WriteEast(aCard: TCard);
var
  pData: BtArray;
  i: integer;
begin
  SetLength(pData, 16);
  pData[0] := aCard.Number and $FF;
  pData[1] := hi(aCard.Number and $ffff);
  pData[2] := (aCard.Number shr 16) or $60;

  for i := 8 to 15 do  pData[i] := $80;
  for i := 0 to length(aCard.Name) - 1 do
    pData[8+i] := ord(aCard.Name[i+1]) + $60;
  WriteBlockData(mcbEast, pData);
  //
end;


//先读出卡中数据，只修改卡中金额和校验，其他照写
procedure Tmifare.OnlyWriteLastMoney(aCard: TCard);
var
  rData: BtArray;
  Balance: Currency;
  intMoney,DecMoney :Cardinal;
begin
  if not ReadBlockData(mcbBalance,rData) then
    raise EMifareError.Create('未读到卡数据');

  Balance := aCard.Money * 10000;
  intMoney:= abs(StrToInt64(CurrToStr(Balance))) div 10000;
  decMoney:= (abs(StrToInt64(CurrToStr(Balance))) - intMoney*10000) div 100;

  Setlength(rData,16);
  rData[0]:= hi(intMoney);
  rData[1]:= lo(intMoney);
  rData[2]:= decMoney;
  if aCard.Money < 0 then rData[0] := rData[0] or $80;

  rData[15] :=(rData[0] xor rData[1] xor rData[2]);

  WriteBlockData(mcbBalance,rData);
end;

procedure Tmifare.WriteMoney(aCard: TCard);
var
  intMoney,DecMoney :Cardinal;
  pData : BtArray;
  Balance: Currency;

begin
  //剩余金额
  Balance := aCard.Money * 10000;
  intMoney:= abs(StrToInt64(CurrToStr(Balance))) div 10000;
  decMoney:= (abs(StrToInt64(CurrToStr(Balance))) - intMoney*10000) div 100;

  Setlength(pData,16);
  pData[0]:= hi(intMoney);
  pData[1]:= lo(intMoney);
  pData[2]:= decMoney;
  //处理负数
  if (StrToInt64(CurrToStr(Balance))<0) then pData[0]:=pData[0] or $80;

  //日消费累计
  Balance := aCard.DaySumMoney * 10000;
  intMoney:= abs(StrToInt64(CurrToStr(Balance))) div 10000;
  decMoney:= (abs(StrToInt64(CurrToStr(Balance))) - intMoney*10000) div 100;

  pData[3]:= hi(intMoney);
  pData[4]:= lo(intMoney);
  pData[5]:= decMoney;

  //消费当日
  pData[6]:= aCard.CurDay;
  //单次限额
  pData[7]:= aCard.SingleLimit div $100;
  pData[8]:= aCard.SingleLimit mod $100;
  //日限额
  pData[9]:= aCard.DayLimit div $100;
  pData[10]:= aCard.DayLimit mod $100;
  //透支限额
  pData[11]:= aCard.OverDraft div $100;
  pData[12]:= aCard.OverDraft mod $100;

  pData[13]:= 0;

  pData[14]:= 0;//aBalance.Flag; 0代表正常

  pData[15] :=(pData[0] xor pData[1] xor pData[2]);

  WriteBlockData(mcbBalance,pData);


end;

end.


